#*************************************************************************
#*
#*  $RCSfile$
#*
#*  $Id: tcluno.tcl 209 2006-04-28 12:23:05Z grosserw $
#*
#*  last change: $Author: grosserw $ $Date: 2006-04-28 14:23:05 +0200 (Fr, 28 Apr 2006) $
#*
#*  The Contents of this file are made available subject to the terms of
#*  the following license
#*
#* 	- BSD License
#*
#*	see file license/license.terms in this directory
#*
#*  Copyright 2005 Wolfgang Grosser
#*
#*  Author: Wolfgang Grosser
#*
#*  Contributor(s): 
#*
#************************************************************************/

package require log
namespace eval ::tcluno_soffice {

variable supportedFormats [list \
	private:factory/scalc \
	private:factory/swriter \
	private:factory/simpress \
	private:factory/swriter/web \
	private:factory/sdraw \
	private:factory/smath \
	private:factory/swriter/Global
]

variable localContext {}
variable remoteServiceManager {}
variable desktop {}
variable doc {}
variable false {}
variable true {}
variable desk_top_is_initted 0


# ******************************* initServiceManager ************************

proc initServiceManager {} {
	set ::tcluno_soffice::_debug 0
	if {[string length $::tcluno_soffice::localContext] == 0} {
		set ::tcluno_soffice::localContext [::tcluno::getComponentContext 1]
		set ::tcluno_soffice::localServiceManager [$::tcluno_soffice::localContext ServiceManager]
		set unoResolver [$::tcluno_soffice::localServiceManager createInstanceWithContext "com.sun.star.bridge.UnoUrlResolver" $::tcluno_soffice::localContext]
		set connect_str "uno:socket,host=localhost,port=2002;urp;StarOffice.ComponentContext"
		set ::tcluno_soffice::remoteContext [$unoResolver resolve $connect_str]
		if {[string length $::tcluno_soffice::remoteContext] == 0} {
			set my_info "cannot connect to: $connect_str!\nin doing:set ::tcluno_soffice::remoteContext \[$unoResolver resolve $connect_str\]"
			error "cannot connect to: $connect_str!" $my_info
		}
		set ::tcluno_soffice::remoteServiceManager [$::tcluno_soffice::remoteContext getServiceManager]
		set true [$::tcluno_soffice::remoteServiceManager tcluno::getTclBoolean True]
		set false [$::tcluno_soffice::remoteServiceManager tcluno::getTclBoolean False]
	}
}

# ******************************* initDesktop ******************************

proc initDesktop {{init_service_manager 1} {force_reset 0}} {
	if {$::tcluno_soffice::desk_top_is_initted} {
		if {[catch {
			set xx [$::tcluno_soffice::remoteContext getServiceManager]
		} msg]} {
			puts stderr "$msg:"
			puts stderr "forcing new initialisation:"
			set force_reset 1
		}
	}
	if {$force_reset} {
		set ::tcluno_soffice::desk_top_is_initted 0
		set init_service_manager 1
		set ::tcluno_soffice::desktop [list]
	}
	if {$init_service_manager} {
		if {! $::tcluno_soffice::desk_top_is_initted} {
			set ::tcluno_soffice::desk_top_is_initted 1
			set ::tcluno_soffice::localContext ""
			if {[catch {initServiceManager} error]} {
				return -code error $error
			}
		}
	}
	if {[string length $tcluno_soffice::desktop] == 0} {
		set tcluno_soffice::desktop [$tcluno_soffice::remoteServiceManager createInstanceWithContext "com.sun.star.frame.Desktop" $tcluno_soffice::remoteContext]
	}
	return $tcluno_soffice::desktop
}

# ******************************* makePropertySequence *********************

proc makePropertySequence {cmd class_name args} {
	set my_seq [$cmd tcluno::createUnoSequence Any]
	set append {}
	foreach property_infos $args {
		set my_property_struct [$cmd tcluno::createUnoStructHelper $class_name [list]]

		foreach {name value} $property_infos {
			if {[catch {$my_property_struct tcluno::setPropertyValueByName $name $value} msg]} {
				log::log debug "error in setPropertyValueByName:$msg"
			}
		}
		set append [$cmd tcluno::appendUnoSequence $my_seq $my_property_struct]
	}
	return $my_seq
}

# ******************************* makeInitializedPropertySequence ************

proc makeInitializedPropertySequence {cmd class_name init_lst} {
	set my_seq [$cmd tcluno::createUnoSequence Any]
	set append [list]
	set my_property_struct [$cmd tcluno::createUnoStructHelper $class_name $init_lst]
	set append [$cmd tcluno::appendUnoSequence $my_seq $my_property_struct]
	return $my_seq
}

# ******************************* getEmptyPropertySequence *******************

proc getEmptyPropertySequence {cmd} {
	return [::tcluno_soffice::makePropertySequence $cmd com.sun.star.beans.PropertyValue]
}

# ******************************* useSheet **********************************

proc useSheet {desktop index} {
	set ::tcluno_soffice::model [$::tcluno_soffice::desktop getCurrentComponent]
	uplevel set ::tcluno_soffice::sheets(::tcluno_soffice::model:$::tcluno_soffice::desktop) $model
	set sheet [$::tcluno_soffice::model getSheets]
	set tab [$sheet getByIndex $index]
	return [list $tab $sheet]
}

# ******************************* checkType ****************************

proc checkType {type} {
	foreach e $::tcluno_soffice::supportedFormats {
		if {[string equal $type $e]} {
			return 1
		}
	}
	return 0
}

# ******************************* createDocument ****************************

proc createDocument {type} {
	if {![checkType $type]} {
		error "wrong type"
	}
	set props [getEmptyPropertySequence $::tcluno_soffice::desktop]
	set doc [$::tcluno_soffice::desktop loadComponentFromURL $type "_blank" 0 $props]
	return $doc
}

# ******************************* openDocument ****************************

proc openDocument {name} {
	set props [getEmptyPropertySequence $::tcluno_soffice::desktop]
	log::log debug exists:$name:[file exists [string range $name 5 end]]:
	set doc [$::tcluno_soffice::desktop loadComponentFromURL $name "_blank" 0 $props]
	log::log debug doc:$doc:
	return $doc
}

# ******************************* openDocumentAs ****************************

proc openDocumentAs {name props} {
	set filename [string range $name 5 end]
	log::log debug $filename:[file exists $filename]
	set doc [$::tcluno_soffice::desktop loadComponentFromURL $name "_blank" 0 $props]
	return $doc
}

# ******************************* show_method_infos *************************

proc show_method_infos {cmd {retList 0}} {
	set member_infos [$cmd tcluno::getMemberMethodInfos $cmd]
	log::log debug "METHOD_INFOS"
	foreach entry $member_infos {
		foreach {method_name ret_type} $entry break
		set param_infos [lrange $entry 2 end]
		set params ""
		set sep ""
		foreach {mode type name} $param_infos {
			append params "$sep\[$mode\] $type $name"
			set sep ", "
		}
		set method_infos($method_name) [list $ret_type "$method_name ( $params )"]
	}
	set result [list]
	foreach method_name [lsort [array names method_infos]] {
		set my_infos $method_infos($method_name)
		foreach {ret_type str} $my_infos break
		log::log debug "  $ret_type\n$str"
		lappend result [list $ret_type $str]
	}
	if {$retList} {
		return $result
	}
}

# ******************************* getMemberMethodNames ********************

proc getMemberMethodNames {cmd} {
	return [$cmd tcluno::getMemberMethodNames]
}

# ******************************* getMemberPropertyNames ******************

proc getMemberPropertyNames {cmd} {
	return [$cmd tcluno::getMemberPropertyNames]
}

# ******************************* getEnumInfos ****************************

proc getEnumInfos {cmd class} {
	return [$cmd tcluno::getEnumInfos $class]
}

# ******************************* getMemberMethodInfo *********************

proc getMemberMethodInfo {cmd method} {
	set members [$cmd tcluno::getMemberMethodInfos $cmd]
	foreach member $members {
		foreach {name ret_type} $member break
		if {![string equal $name $method]} continue
		return [list params [lrange $member 2 end] ret_type $ret_type]
	}
	return [list]
}

# ******************************* listMethodInfos *************************

proc listMethodInfos {cmd} {
	set member_infos [$cmd tcluno::getMemberMethodInfos $cmd]
	log::log debug "METHOD_INFOS"
	foreach entry $member_infos {
		foreach {method_name ret_type} $entry break
		set param_infos [lrange $entry 2 end]
		set params ""
		set sep ""
		foreach {mode type name} $param_infos {
			lappend params $mode $type $name
		}
		set method_infos($method_name) [list params $params ret_type $ret_type]
	}
	return [array get method_infos]
}

# ******************************* getProperties ***************************

proc getProperties {cmd} {
	set properties [$cmd getPropertySetInfo]
	return [$properties getProperties]
}

# ******************************* propertyValue ***************************

proc propertyValue {cmd property {value ""}} {
	if {[string length $value] > 0} {
		$cmd setPropertyValue $property $value
	}
	return [$cmd getPropertyValue $property]
}

# ******************************* windowTitle *****************************

proc windowTitle {cmd {title ""}} {
	log::log debug $cmd
	set activeFrame [$cmd getPropertyValue ActiveFrame]
	log::log debug $activeFrame
	if {[string length $title] > 0} {
		$activeFrame setPropertyValue Title $title
	}
	return [$activeFrame getPropertyValue Title]
}
proc getPropertyValues {object} {
	set propSet [$object getPropertySetInfo]
	return [$propSet getProperties]
}
proc getUnitFactor {unit} {
	set factor 1
	switch $unit {
		cm {
			set factor 1000
		}
		mm {
			set factor 100
		}
		i -
		in -
		inch {
			set factor 2540
		}
	}
	return $factor
}
proc createRectangle {rectangle} {
	foreach {x y w h unit} $rectangle break
	set factor [getUnitFactor $unit]
	set x [expr {$x*$factor}]
	set y [expr {$y*$factor}]
	set w [expr {$w*$factor}]
	set h [expr {$h*$factor}]
	set rectangle [$tcluno_soffice::desktop tcluno::createUnoStructHelper com.sun.star.awt.Rectangle [list $x $y $w $h]]
	return $rectangle
}

proc createPoint {point} {
	foreach {x y unit} $point break
	set factor [getUnitFactor $unit]
	set x [expr {int($x*$factor)}]
	set y [expr {int($y*$factor)}]
	set point [$tcluno_soffice::desktop tcluno::createUnoStructHelper com.sun.star.awt.Point [list $x $y]]
	return $point
}
proc createSize {size} {
	foreach {w h unit} $size break
	set factor [getUnitFactor $unit]
	set w [expr {int($w*$factor)}]
	set h [expr {int($h*$factor)}]
	set size [$tcluno_soffice::desktop tcluno::createUnoStructHelper com.sun.star.awt.Size [list $w $h]]
	return $size
}

}

package provide tcluno_soffice 0.0
